home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.10 / medplayerlibrary / medplay1.0d.p < prev    next >
Text File  |  1995-04-19  |  6KB  |  290 lines
  1. program medplay4;
  2.  
  3. { This example uses medplayer.library. Use PCQ-Pascal V1.2 }
  4.  
  5. {$I "Include:Libraries/medplayer.i"  }
  6. {$I "Include:libraries/dos.i"   }
  7. {$I "Include:exec/Libraries.i"  }
  8. {$I "Include:exec/memory.i"  }
  9. {$I "Include:utils/Parameters.i"  }
  10. {$I "Include:utils/Stringlib.i"  }
  11. {$I "Include:intuition/intuition.i"  }
  12. {$I "Include:diesel/MyFReq2.i"  }
  13. {$I "Include:diesel/AutoReq.i"  }
  14.  
  15. Const
  16.     NumGads = 5;
  17.  
  18.     NewWin : NewWindow  = ( 0,20,315,30, 0,2, CloseWindow_f+GadgetUp_f,
  19.                 WindowDrag+WindowDepth+WindowClose+RMBTrap,
  20.                 NIL, NIL, NIL,NIL, NIL,
  21.                 0,0,0,0, WBenchScreen_f);
  22.  
  23.  
  24.     RawGad : Gadget        = ( NIL, 0,14, 46,11, GadgHBox, RelVerify,
  25.                 boolgadget, NIL, NIL, NIL, 0, NIL, 0, NIL );
  26.  
  27.  
  28.     RawTxt : IntuiText  = ( 2,0, jam1, 4,2, NIL, NIL, NIL );
  29.  
  30.     GadTxt : Array[0..NumGads-1] of String = ("Load",
  31.                           " New",
  32.                           "Start",
  33.                           "Stop",
  34.                           "Cont");
  35.  
  36.  
  37.  
  38. Type
  39.     gadarr      = Array[0..NumGads-1] of Gadget;
  40.     txtarr      = Array[0..NumGads-1] of IntuiText;
  41.     gadArrPtr = ^GadArr;
  42.     txtArrPtr = ^txtarr;
  43.  
  44. VAR
  45.     WB      : WBStartupPtr;
  46.     gads1,
  47.     gads2      : GadArrPtr;
  48.     txts1,
  49.     txts2      : txtarrPtr;
  50.     slect      : GadgetPtr;
  51.  
  52.     home,
  53.     sea      : FileLock;
  54.     i      : Short;
  55.     res,
  56.     MpDir,
  57.     MpFile,
  58.     MpPath,
  59.     name      : String;
  60.     gp,
  61.     class      : Integer;
  62.     module1,
  63.     module2      : MMD0Ptr;
  64.     Win      : WindowPtr;
  65.     WMsgPort  : MsgPortPtr;
  66.     Msg      : IntuiMessagePtr;
  67.     buf      : Array[0..99] of Char;
  68.  
  69.  
  70. { --------------------------------------------------------------------- }
  71.  
  72. PROCEDURE CleanExit( why : String; rt : Integer);
  73. BEGIN
  74.     IF  Win <> NIL          THEN CloseWindow( Win );
  75.  
  76.     IF  gp = 0          THEN  FreePlayer;
  77.     IF  module1 <> NIL      THEN UnloadModule( module1 );
  78.  
  79.     IF  ReqBase <> NIL      THEN CloseLibrary( ReqBase );
  80.     IF  MEDPlayerBase <> NIL  THEN CloseLibrary( MEDPlayerBase );
  81.     IF  home <> NIL       THEN home := CurrentDir( home );
  82.     IF  why <> NIL          THEN
  83.     BEGIN
  84.       write( why );
  85.       Delay(50);
  86.     END;
  87.  
  88.     Exit( rt );
  89. END;
  90.  
  91. { --------------------------------------------------------------------- }
  92.  
  93. FUNCTION ReqAFile: String;    { NIL zurück -> OK }
  94. Var
  95.     ok : Integer;
  96.  
  97. BEGIN
  98.     IF ReqBase <> NIL THEN BEGIN
  99.  
  100.       ok := FileReq( "Medplay 1.0d (C)93/Diesel", MpDir, MpFile, MpPath );
  101.       IF ok <> 0 THEN ReqAFile := "Error on requesting file !\n";
  102.       strcpy( name, MpPath );
  103.       ReqAFile := NIL;
  104.  
  105.     END ELSE BEGIN
  106.       IF SysReq("Konnte req.library nicht laden","Schade","Schade")THEN;      
  107.       ReqAFile := "Sorry, no req.library\n";
  108.     END;
  109. END;
  110.  
  111. { --------------------------------------------------------------------- }
  112.  
  113.  
  114.  
  115. PROCEDURE OpentheWindowETC;
  116. BEGIN
  117.     New( gads1 );    gads2 := gads1;
  118.     New( txts1 );    txts2 := txts1;
  119.  
  120.     For i := 0 to NumGads-1 do BEGIN
  121.       CopyMem( Adr(RawTxt), Adr(txts1^[i]), SizeOf(IntuiText) );
  122.       txts1^[i].IText := gadtxt[i];
  123.  
  124.       gads2 := Address( Integer(gads2) + SizeOf(Gadget) );
  125.  
  126.       CopyMem( Adr(RawGad), Adr(gads1^[i]), SizeOf(Gadget) );
  127.       With gads1^[i] do BEGIN
  128.         GadgetID   := i + 1;
  129.         leftEdge   := 12 + i * 60;
  130.         nextGadget := GadgetPtr( gads2 );
  131.         GadgetText := Adr( txts1^[i] );
  132.       END;
  133.  
  134.     END;
  135.     gads1^[NumGads-1].NextGadget := NIL;
  136.  
  137.     NewWin.Title := name;
  138.     NewWin.FirstGadget := GadgetPtr( gads1 );
  139.     Win := OpenWindow( Adr(NewWin) );
  140.     IF Win = NIL THEN CleanExit("Cannot open window\n",0);
  141.  
  142. END;
  143.  
  144.  
  145.  
  146.  
  147. { --------------------------------------------------------------------- }
  148.  
  149. BEGIN
  150.     gp := -1;
  151.     home := NIL;
  152.     name   := AllocString( 162 );
  153.     MpDir  := AllocString( 131 );
  154.     MpFile := AllocString(  31 );
  155.     MpPath := AllocString( 162 );
  156.     MpDir[0]  := chr(0);
  157.     MpFile[0] := chr(0);
  158.     MpPath[0] := chr(0);
  159.  
  160.     MEDPlayerBase := OpenLibrary( medname, 0 );
  161.     IF MEDPlayerBase = NIL THEN
  162.       CleanExit("Cannot open medplayer.library\n", 10);
  163.  
  164.     ReqBase := OpenLibrary("req.library",0);
  165.  
  166.     WB := GetStartupMsg();
  167.     IF WB <> nil THEN BEGIN
  168.       IF WB^.sm_NumArgs > 1 THEN BEGIN
  169.         strcpy( name, WB^.sm_ArgList^[2].wa_Name );
  170.       END ELSE BEGIN
  171.         res := ReqAFile;
  172.       END;
  173.       home := CurrentDir( WB^.sm_ArgList^[2].wa_Lock );
  174.  
  175.     END ELSE BEGIN
  176.  
  177.       GetParam( 1, name );
  178.       IF name[0]= chr(0) THEN
  179.         CleanExit("Medplay 1.0d, 1993 by Diesel\nUsage: Medplay med-modulename\n\n",0);
  180.       strcpy( MpPath, name );
  181.     END;
  182.  
  183.  
  184.  
  185.     gp := GetPlayer(0);
  186.     IF ( gp <> 0 ) THEN
  187.       CleanExit("Cannot init player\n",0);
  188.  
  189.     IF name[0] <> chr(0) THEN BEGIN
  190.       module1 := LoadModule( name );
  191.       IF module1 = NIL THEN
  192.         CleanExit("Cannot load module\n",0);
  193.     END;
  194.  
  195.     OpentheWindowETC;
  196.  
  197.     IF module1 <> NIL THEN    PlayModule(module1);
  198.  
  199.  
  200.     WMsgPort:=Win^.UserPort;        { MsgPort holen  }
  201.  
  202.     REPEAT
  203.       REPEAT
  204.         Msg := IntuiMessagePtr( WaitPort( WMsgPort ));
  205.         Msg := IntuiMessagePtr(   GetMsg( WMsgPort ));
  206.       UNTIL Msg <> NIL ;
  207.  
  208.  
  209.  
  210.       class := Msg^.class;
  211.       slect := GadgetPtr( Msg^.iAddress );
  212.       ReplyMsg( MessagePtr( Msg ) );    { OK to sender  } 
  213.  
  214.       CASE class OF
  215.  
  216.         GADGETUP_F :
  217.         BEGIN
  218.           CASE Slect^.GadgetID OF
  219.  
  220.           1 : BEGIN
  221.             IF ReqAFile <> NIL THEN
  222.               DisplayBeep(NIL)
  223.             ELSE BEGIN
  224.               module2 := LoadModule( name );
  225.               IF    module2 = NIL
  226.               THEN  DisplayBeep(NIL)
  227.               ELSE  BEGIN
  228.                 DimOffPlayer( 15 );
  229.             Delay(100);
  230.                 IF module1<>NIL THEN UnloadModule( module1 );
  231.                 module1 := module2;
  232.                 PlayModule( module1 );
  233.                 module2 := NIL;
  234.               END;
  235.             END;
  236.           END;
  237.  
  238.           2 : BEGIN
  239.             IF module1 <> NIL THEN BEGIN
  240.               StopPlayer;
  241.               UnloadModule( module1 );
  242.               module1 := NIL;
  243.               IF ReqAFile <> NIL THEN BEGIN
  244.                 DisplayBeep(NIL);
  245.               END ELSE BEGIN
  246.                 module1 := LoadModule( name );
  247.                 IF module1 = NIL
  248.                 THEN  DisplayBeep(NIL)
  249.                 ELSE  PlayModule( module1 );
  250.               END;
  251.             END;
  252.           END;
  253.  
  254.           3 : BEGIN
  255.             PlayModule( module1 );
  256.           END;
  257.  
  258.           4 : BEGIN
  259.             StopPlayer;
  260.           END;
  261.  
  262.           5 : BEGIN
  263.             ContModule( module1 );
  264.           END;
  265.  
  266.           ELSE END;
  267.             END;
  268.  
  269.       ELSE END;
  270.     UNTIL class = CLOSEWINDOW_f;
  271.  
  272.  
  273.  
  274.     REPEAT
  275.       Msg:=IntuiMessagePtr(GetMsg(WMsgPort));   { Msg holen, = NIL ? }
  276.       IF Msg <> NIL THEN
  277.         ReplyMsg(MessagePtr(Msg));            { Msg beantworten    }
  278.     UNTIL Msg = NIL;
  279.      CloseWindow( Win );
  280.     Win := NIL;
  281.  
  282.  
  283.     DimOffPlayer(12);
  284.     Delay(100);
  285.  
  286.  
  287.     CleanExit( NIL, 0 );
  288. END.
  289.  
  290.